Shareware Grab Bag/Shareware Grab Bag.iso/011/libutil.arc/LIB-UTIL.BAS

GW-BASIC | 1985-06-27 | 22.8 KB | 476 lines

100  REM ----------------------------------------------------------------------
110  REM | Copyright (c) 1983 - Scott Loftesness. All Rights Reserved.        |
120  REM | Program Name: LU --- A BASIC Library Manager                       |
130  REM | Author:       Scott Loftesness                                     |
140  REM |               20324 Highland Hall Drive                            |
150  REM |               Gaithersburg, MD 20879                               |
160  REM | Date:         4/16/83                                              |
170  REM | Purpose:                                                           |
180  REM |  To manage a library containing several files in a single file.    |
190  REM |  This program is based on the library format by G. Novosielski     |
195  REM |  modified by Scott Loftesness to add date and time information.    |
200  REM ----------------------------------------------------------------------
210  DEFINT A-Z:COLOR 14,1,1:CLS:KEY OFF
215  TITLE$="PC/Library (Version 1.0 - 4/16/83)"
220  LOCATE 1,1:PRINT STRING$(79,&HC4);
230  LOCATE 24,1:PRINT STRING$(79,&HC4);
240  FOR I=1 TO 24:LOCATE I,1:PRINT CHR$(&HB3);
245  LOCATE I,79:PRINT CHR$(&HB3);:NEXT I
250  LOCATE 1,1:PRINT CHR$(&HDA);:LOCATE 1,79:PRINT CHR$(&HBF);:LOCATE 24,1:PRINT CHR$(&HC0);:LOCATE 24,79:PRINT CHR$(&HD9);
260  LOCATE 3,2:H1$="Library Utility (LU)  for the IBM Personal Computer":GOSUB 990
270  LOCATE 4,2:H1$="Version 1.0 - (C) Copyright 1983 - Scott Luftesness":GOSUB 990
280  DIM I$(100),S$(10):S$(1)="Build New Library"
290  S$(2)="List Library Directory"
300  S$(3)="List Directory & Add Library Member"
310  S$(4)="List Directory & Get Library Member"
320  S$(5)="List Directory & List Library Member"
330  S$(6)="List Directory & Delete Library Member"
340  S$(7)="Spread Library to Individual Files"
345  S$(8)="Reorganize Existing Library"
347  S$(9)="Return to PC-DOS"
350  START=6
360  FOR I=1 TO 9
370  LOCATE START,20
380  PRINT S$(I);" ";STRING$(40-LEN(S$(I)),".");I;
390  START=START+2
400  NEXT I
410  LOCATE START+1,2
420  PRINT "Your Selection Please: ";:PLAY "L16 FF"
430  LOCATE ,,1,0,11
440  I$=INKEY$:IF I$="" THEN 440
450  LOCATE ,,0:IF LEN(I$)>1 THEN BEEP:GOTO 440
460  IF (VAL(I$)>0) AND (VAL(I$)<10) THEN ON VAL(I$) GOTO 1000,4000,8000,3000,3000,7000,5000,995,6000
470  BEEP:LOCATE 25,40:PRINT SPC(25);:LOCATE 25,40:PRINT "ERROR- Invalid Selection!";:GOTO 410
500  REM ----------------------------------------------------------------------
510  REM | Subroutine to Get Filename Info from user.                         |
520  REM ----------------------------------------------------------------------
530  INPUT "Enter library name (w/o extension):",ARCHNAME$
540  IF ARCHNAME$="" THEN RETURN
550  IF INSTR(ARCHNAME$,".")<>0 THEN PRINT:PRINT "ERROR - Invalid file name specified - do not specify extension.":PRINT:GOTO 530
560  ARCHFIL$=ARCHNAME$+".lbr":ARCHDIR$=ARCHFIL$
570  RETURN
600  REM ----------------------------------------------------------------------
610  REM | Subroutine to Copy file into library (From #3 to #2)               |
620  REM ----------------------------------------------------------------------
630  FOR L!=0 TO LOF(3)-1 STEP 128
640  GET #3
650  FIELD 3, 128 AS INREC$
660  RECCNT=RECCNT+1
670  FIELD 2, 128 AS OUTREC$
680  LSET OUTREC$=INREC$
690  PUT #2,RECCNT
700  NEXT L!
710  RETURN
720  REM ----------------------------------------------------------------------
730  REM | Subroutine to List Directory Contents                              |
740  REM ----------------------------------------------------------------------
750  PRINT "Directory Contents for Library File: ";ARCHNAME$+".LBR"
760  PRINT:PRINT   " File  Name  Start # Sec Bytes --Date-- --Time--"
780  PRINT         "------------ ----- ----- ----- -------- --------"
790  HILAST=0:'Highest sector in use.
800  NUMDIR=0:'Number of valid directory entries.
810  GET #1:' Skip over directory entry itself.
814  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
816  TOTDIR=(CVI(LAST$)*4)-1
820  GET #1
830  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
840  IF DONE$=CHR$(255) THEN GOTO 930:'Exit if complete
845  NUMDIR=NUMDIR+1
850  IF DONE$=CHR$(254) THEN GOTO 820:'Skip deleted files.
860  IF HILAST<CVI(START$) THEN HILAST=CVI(START$):LASTSEC=CVI(LAST$):'Save highest sector in use.
880  PRINT PRINAME$;" ";SECNAME$;
890  PRINT USING " #####";CVI(START$);CVI(LAST$);128*CVI(LAST$);:PRINT " ";FILEDATE$;" ";FILETIME$
910  GOTO 820
930  RETURN
940  REM ----------------------------------------------------------------------
941  REM | Subroutine to Copy file out of library (From #2 to #3)             |
942  REM ----------------------------------------------------------------------
943  FOR I=1+CVI(START$) TO 1+CVI(START$)+CVI(LAST$)-1
944  GET #2,I
946  FIELD 2, 128 AS INREC$
947  FIELD 3, 128 AS OUTREC$
948  LSET OUTREC$=INREC$
949  PUT #3
950  NEXT I
951  RETURN
952  REM ----------------------------------------------------------------------
953  REM | Subroutine to list a file in a library                             |
954  REM ----------------------------------------------------------------------
955  FOR I=1+CVI(START$) TO (CVI(START$)+CVI(LAST$))
956  GET #2,I
957  FIELD 2, 128 AS INREC$
958  PRINT INREC$;
959  NEXT I
960  RETURN
980  GOTO 980
990  LOCATE ,((78-LEN(H1$))/2):PRINT H1$;:RETURN
995  LOCATE 25,40:PRINT "ERROR - Option Not Implemented Yet!";:BEEP:GOTO 410
1000  REM ----------------------------------------------------------------------
1020  REM | Program Name: LUBLD -- A BASIC Library Builder                     |
1070  REM | Purpose:                                                           |
1080  REM |  To create an library from several individual input files.         |
1090  REM |  This program is based on the library format by G. Novosielski.    |
1100  REM | Comments:                                                          |
1110  REM |  Input is an uncompressed library filename (without any extension).|
1120  REM |  This program creates an library with the user specified name.     |
1130  REM |  Filenames created are of the form:                                |
1140  REM |             <filename>.lbr                                         |
1150  REM |  which contains a directory portion and a data portion.            |
1160  REM |                                                                    |
1170  REM |  The directory contains a 32 byte record for each file in the      |
1180  REM |  library. The format of this record is as follows:                 |
1190  REM |  Offset Length Description                                         |
1200  REM |    0      1    Flag Byte - as follows:                             |
1210  REM |                00 - Indicates an active directory entry.           |
1220  REM |                FE - Indicates a deleted entry.                     |
1230  REM |                FF - Indicates an unused entry.                     |
1240  REM |    1      8    Primary file name - must be upper case. Left        |
1250  REM |                justified with blanks.                              |
1260  REM |    9      3    File extension - must be upper case. Left just.     |
1270  REM |   12      2    Starting record number in <filename>.LBR for this   |
1280  REM |                file. (Records are 128 bytes long)                  |
1290  REM |   14      2    Number of sectors in file.                          |
1300  REM |   16      8    Member creation date.                               |
1305  REM |   24      8    Member creation time.                               |
1310  REM |  The library file itself consists of 128 byte records. If a file   |
1320  REM |  is not an even multiple of 128 bytes in length, the final record  |
1330  REM |  is padded to make the file an even multiple. The pad character is |
1340  REM |  chr$(00).                                                         |
1350  REM | Requires:                                                          |
1360  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
1370  REM |  This program operates only in 80 character wide text mode. It     |
1380  REM |  assumes the screen is in that mode at entry.                      |
1390  REM ----------------------------------------------------------------------
1400  CLS
1410  GOSUB 500 ' Get Filename from User.
1420  IF ARCHNAME$="" THEN GOSUB 6100:RUN
1450  ON ERROR GOTO 2180:'Test for file available.
1460  OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
1470  PRINT:PRINT "File "+ARCHFIL$+" already exists. Re-write this file? <N/Y>";:INPUT I$
1480  IF I$="Y" OR I$="y" THEN GOTO 1490 ELSE GOTO 1410
1490  ON ERROR GOTO 0:'Delete file not available error routine.
1500  PRINT:INPUT "Enter maximum number of entries library is to contain:";NUMENT
1510  NUMENT=NUMENT+1:NUMDIR=NUMENT\4
1520  IF NUMENT MOD 4>0 THEN NUMDIR=NUMDIR+1
1530  CLS:PRINT "LUBLD    -    ";TITLE$
1540  PRINT:PRINT"Formatting library directory...";
1550  OPEN ARCHFIL$ AS #1 LEN=32
1560  FOR I=1 TO NUMENT*4
1570  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
1580  LSET DONE$=CHR$(255):LSET PRINAME$=STRING$(8,0):LSET SECNAME$=STRING$(3,0)
1590  LSET START$=MKI$(0):LSET LAST$=MKI$(0)
1595  WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
1600  PUT #1
1610  NEXT I
1620  LSET DONE$=CHR$(0):LSET PRINAME$="********":LSET SECNAME$="DIR":LSET START$=MKI$(0):LSET LAST$=MKI$(NUMDIR):PUT #1,1
1630  CLOSE #1
1640  PRINT"Format complete."
1650  OPEN ARCHFIL$ AS #2 LEN=128
1660  PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
1670  NUMFILES=0
1680  ON ERROR GOTO 2190
1690  NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
1700  IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 1800
1710  FOR I=1 TO LEN(I$(NUMFILES))
1720  IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
1730  NEXT I
1740  FOR J=1 TO NUMFILES-1
1750  IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 1690
1760  NEXT J
1770  OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
1780  IF NUMFILES=NUMENT THEN GOTO 1800
1790  GOTO 1690
1800  ON ERROR GOTO 0
1810  IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 1660
1820  PRINT:PRINT NUMFILES;" files to be included in Library ";ARCHNAME$
1830  RECCNT=NUMDIR
1840  FOR I=1 TO NUMFILES
1850  INCNT=0
1860  OPEN I$(I) AS #3 LEN=128
1870  PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
1880  STARTCNT=RECCNT
1890  GOSUB 600 ' Go copy the file into the library.
1970  CLOSE #3
1980  CLOSE #2
1990  CLOSE:OPEN ARCHFIL$ AS #1 LEN=32
2000  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
2010  LSET PRINAME$="":LSET SECNAME$=""
2020  LSET START$=MKI$(STARTCNT)
2030  LSET LAST$=MKI$(RECCNT-STARTCNT)
2040  LSET DONE$=CHR$(0)
2045  WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
2050  IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
2060  IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
2070  LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
2080  LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
2090  PUT #1,I+1
2100  LSET DONE$=CHR$(255)
2110  PUT #1
2120  CLOSE #1
2130  OPEN ARCHFIL$ AS #2 LEN=128
2140  NEXT I
2150  CLOSE
2160  PRINT:PRINT "Library build completed - directory updated."
2170  GOSUB 6100:RUN
2180  IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
2190  IF ERR=53 THEN PRINT:PRINT "File: ";I$(NUMFILES);" cannot be opened. Please re-specify.":NUMFILES=NUMFILES-1:RESUME 1690 ELSE ON ERROR GOTO 0
3000  REM ----------------------------------------------------------------------
3020  REM | Program Name: LUGET -- A BASIC Library File Retriever              |
3070  REM | Purpose:                                                           |
3080  REM |  To copy a file from an library to a separate file.                |
3090  REM |  This program is based upon the LU library format by G. Novosielski|
3100  REM | Comments:                                                          |
3110  REM |  Input is an uncompressed library filename (without any extension).|
3120  REM |  This program reads and lists the contents of the library          |
3130  REM |  directory. It then prompts the user for the name of the file to   |
3140  REM |  be retrieved. Filename is of the form:                            |
3150  REM |             <filename>.lbr                                         |
3160  REM | Requires:                                                          |
3170  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
3180  REM |  This program operates only in 80 character wide text mode. It     |
3190  REM |  assumes the screen is in that mode at entry.                      |
3200  REM ----------------------------------------------------------------------
3210  CLS
3220  GOSUB 500
3230  IF ARCHNAME$="" THEN GOSUB 6100:RUN
3270  ON ERROR GOTO 3880:'Test for file available.
3280  OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
3290  OPEN ARCHFIL$ FOR INPUT AS #2:CLOSE #2
3300  ON ERROR GOTO 0:'Delete file not available error routine.
3310  OPEN ARCHDIR$ AS #1 LEN=32
3320  CLS:IF VAL(I$)=4 THEN PRINT "LUGET    -    ";TITLE$
3325  IF VAL(I$)=5 THEN PRINT "LUTYPE   -    ";TITLE$
3330  GOSUB 720
3510  PRINT:IF VAL(I$)=4 THEN INPUT "Enter file name to be retrieved :";GETFIL$
3515  IF VAL(I$)=5 THEN INPUT "Enter file name to be listed :";GETFIL$
3520  IF GETFIL$="" THEN GOSUB 6100:RUN
3530  IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 3510
3540  FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
3550  IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
3560  NEXT I
3570  IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
3580  FOR I=2 TO NUMDIR+1
3590  GET #1,I
3600  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
3605  IF DONE$=CHR$(254) THEN GOTO 3620
3610  IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 3640
3620  NEXT I
3630  PRINT:PRINT "ERROR - File not found.":GOTO 3510
3640  OPEN ARCHFIL$ AS #2 LEN=128
3650  OUTFIL$=""
3660  IF INSTR(ARCHNAME$,":")=2 THEN OUTFIL$=LEFT$(ARCHNAME$,2)
3670  OUTFIL$=OUTFIL$+GETPRI$+"."+GETSEC$
3675  IF VAL(I$)=5 THEN GOTO 3780
3680  PRINT:PRINT "Re-specify filename or hit enter to use:";OUTFIL$;:INPUT Q$
3690  IF Q$="" THEN GOTO 3700 ELSE OUTFIL$=Q$
3700  ON ERROR GOTO 3900
3710  OPEN OUTFIL$ FOR INPUT AS #3
3720  PRINT:PRINT "WARNING - File ";OUTFIL$;" already exists. Re-write existing file? <N/Y>";:INPUT Q$
3730  IF Q$="Y" OR Q$="y" THEN GOTO 3740 ELSE PRINT "LUGET - Execution terminated.":CLOSE #3:GOSUB 6100:RUN
3740  CLOSE #3
3750  ON ERROR GOTO 0
3760  OPEN OUTFIL$ AS #3 LEN=128
3770  PRINT:PRINT"Copying file ";GETPRI$+"."+GETSEC$;" from library ";ARCHFIL$;" (";128*CVI(LAST$);" bytes) to file ";OUTFIL$;"."
3780  IF VAL(I$)=4 THEN GOSUB 940
3785  IF VAL(I$)=5 THEN CLS:GOSUB 952
3850  CLOSE
3860  PRINT:IF VAL(I$)=4 THEN PRINT "LUGET - Copy completed." ELSE PRINT:PRINT "LUTYPE - Listing Completed."
3870  GOSUB 6100:RUN
3880  IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 3220
3890  ON ERROR GOTO 0
3900  IF ERR=53 THEN RESUME 3760
3910  IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 3650
3920  ON ERROR GOTO 0
4000  REM ----------------------------------------------------------------------
4020  REM | Program Name: LUDIR -- A BASIC Library Directory Lister            |
4070  REM | Purpose:                                                           |
4080  REM |  To list the contents of an library directory.                     |
4090  REM |  Uses the library format devised by Gary Novosielski for CP/M.     |
4100  REM | Comments:                                                          |
4110  REM |  Input is an uncompressed library filename (without any extension).|
4120  REM |  This program reads and lists the contents of the library          |
4130  REM |  directory. Filename  is  assumed to be of the form:               |
4140  REM |             <filename>.lbr                                         |
4150  REM | Requires:                                                          |
4160  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
4170  REM |  This program operates only in 80 character wide text mode. It     |
4180  REM |  assumes the screen is in that mode at entry.                      |
4190  REM ----------------------------------------------------------------------
4200  CLS
4210  GOSUB 500
4220  IF ARCHNAME$="" THEN GOSUB 6100:RUN
4250  ON ERROR GOTO 4440:'Test for file available.
4260  OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
4270  ON ERROR GOTO 0:'Delete file not available error routine.
4280  OPEN ARCHDIR$ AS #1 LEN=32
4290  CLS:PRINT "LUDIR    -    ";TITLE$
4300  GOSUB 720
4310  GOSUB 6100:RUN
4440  IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 4210
4450  IF ERR=64 THEN PRINT "ERROR - Bad filename specified.":RESUME 4210
4460  ON ERROR GOTO 0
5000  REM ----------------------------------------------------------------------
5020  REM | Program Name: LUSPR -- A  Library Expander                         |
5070  REM | Purpose:                                                           |
5080  REM |  To completely unload a  library to individual files.              |
5090  REM | Comments:                                                          |
5100  REM |  Input is an uncompressed library filename (without any extension).|
5110  REM |  This program reads the directory and creates new files from the   |
5120  REM |  directory / source file. Filenames are assumed to be of the form: |
5130  REM |             <filename>.lbr                                         |
5140  REM |  Output files will be created based upon the contents of the dir-  |
5150  REM |  ectory.       These new files will be allocated on the same drive |
5160  REM |  that contains the library itself. Library files are assumed to    |
5170  REM |  be in the format originated by Gary Novosielski   for CP/M systems|
5180  REM |  and widely used on Remote CP/M systems.                           |
5190  REM | Requires:                                                          |
5200  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
5210  REM |  This program assumes an 80 character text display is active when  |
5220  REM |  is begins execution.                                              |
5230  REM ----------------------------------------------------------------------
5240  CLS
5250  GOSUB 500
5280  ON ERROR GOTO 5580:'Test for file available.
5290  OPEN ARCHFIL$ FOR INPUT AS #1:CLOSE #1
5300  ON ERROR GOTO 0:'Delete file not available error routine.
5310  IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2)
5320  OPEN ARCHDIR$ AS #1 LEN=32
5330  OPEN ARCHFIL$ AS #2 LEN=128
5340  GET #1:'Skip directory itself.
5350  GET #1
5360  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
5370  IF DONE$=CHR$(255) THEN GOSUB 6100:RUN:'Exit if complete
5380  IF DONE$=CHR$(254) THEN GOTO 5350:'Skip deleted entries
5390  IF INSTR(PRINAME$," ")>0 THEN O$=LEFT$(PRINAME$,(INSTR(PRINAME$," ")-1))+"."+SECNAME$ ELSE O$=PRINAME$+"."+SECNAME$
5400  OUTNAME$=OUTNAME$+O$
5410  PRINT:PRINT "Copying member ";O$;".":PRINT"   Re-specify filename or hit enter to use:";OUTNAME$;".";:INPUT I$
5420  IF I$="" THEN GOTO 5430 ELSE OUTNAME$=I$
5430  PRINT "   Opening file: ";OUTNAME$;" to copy ";128*CVI(LAST$);" bytes."
5440  OPEN OUTNAME$ AS #3 LEN=128
5450  ON ERROR GOTO 5600
5460  GOSUB 940
5530  ON ERROR GOTO 0
5540  PRINT "Copy completed for file: ";OUTNAME$
5550  CLOSE #3
5560  IF INSTR(ARCHNAME$,":")=2 THEN OUTNAME$=LEFT$(ARCHNAME$,2) ELSE OUTNAME$=""
5570  GOTO 5350
5580  IF ERR=53 THEN PRINT "File not found.":RESUME 5250
5590  ON ERROR GOTO 0
5600  'Error routine for input.
5610  IF ERR=50 AND ERL=5470 THEN ON ERROR GOTO 0:PUT #3:CLOSE #3:RESUME 5350
5620  ON ERROR GOTO 0
6000  CLS:END
6100  LOCATE 25,1:PRINT"Hit ENTER to continue:";:LINE INPUT I$:RETURN
7000  REM ----------------------------------------------------------------------
7010  REM | Program Name: LUDEL -- A BASIC Library File Delete Routine         |
7020  REM | Purpose:                                                           |
7030  REM |  To delete a file currently in a library.                          |
7040  REM |  This program is based upon the LU library format by G. Novosielski|
7050  REM | Comments:                                                          |
7060  REM |  Input is an uncompressed library filename (without any extension).|
7070  REM |  This program deletes a file by changing the first byte to a       |
7080  REM |  hex FE. All other entries in the directory for this file are left |
7090  REM |  unchanged.                                                        |
7100  REM | Requires:                                                          |
7110  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
7120  REM |  This program operates only in 80 character wide text mode. It     |
7130  REM |  assumes the screen is in that mode at entry.                      |
7140  REM ----------------------------------------------------------------------
7150  CLS
7160  GOSUB 500
7170  IF ARCHNAME$="" THEN GOSUB 6100:RUN
7180  ON ERROR GOTO 7610:'Test for file available.
7190  OPEN ARCHDIR$ FOR INPUT AS #1:CLOSE #1
7210  ON ERROR GOTO 0:'Delete file not available error routine.
7220  OPEN ARCHDIR$ AS #1 LEN=32
7230  CLS:PRINT "LUDEL    -    ";TITLE$
7240  GOSUB 720
7260  PRINT:INPUT "Enter file name to be deleted :";GETFIL$
7280  IF GETFIL$="" THEN GOSUB 6100:RUN
7290  IF LEN(GETFIL$)>12 THEN PRINT "ERROR - Filename is too long.":GOTO 7260
7300  FOR I=1 TO LEN(GETFIL$):'Translate to upper case.
7310  IF ASC(MID$(GETFIL$,I))>96 THEN MID$(GETFIL$,I)=CHR$(ASC(MID$(GETFIL$,I))-32)
7320  NEXT I
7330  IF INSTR(GETFIL$,".")<>0 THEN GETPRI$=LEFT$(GETFIL$,INSTR(GETFIL$,".")-1):GETSEC$=MID$(GETFIL$,INSTR(GETFIL$,".")+1)
7340  FOR I=2 TO NUMDIR+1
7350  GET #1,I
7360  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$
7370  IF DONE$=CHR$(254) THEN GOTO 7390
7380  IF GETPRI$+STRING$(8-LEN(GETPRI$)," ")=PRINAME$ THEN IF GETSEC$+STRING$(3-LEN(GETSEC$)," ")=SECNAME$ THEN GOTO 7410
7390  NEXT I
7400  PRINT:PRINT "ERROR - File not found.":GOTO 7260
7410  LSET DONE$=CHR$(254)
7420  PUT #1,I
7580  CLOSE
7590  PRINT:PRINT "LUDEL - Member deleted."
7600  GOSUB 6100:RUN
7610  IF ERR=53 THEN PRINT "ERROR - File not found.":RESUME 7160
7620  ON ERROR GOTO 0
7630  IF ERR=53 THEN RESUME 7540
7640  IF ERR=64 THEN PRINT"ERROR - Invalid filename specified.":RESUME 7420
7650  ON ERROR GOTO 0
8000  REM ----------------------------------------------------------------------
8010  REM | Program Name: LUADD -- A BASIC Library Add File Routine            |
8020  REM | Purpose:                                                           |
8030  REM |  To add a new member to an existing library.                       |
8040  REM | Requires:                                                          |
8050  REM |  This program is written in IBM Personal Computer Disk BASIC.      |
8060  REM |  This program operates only in 80 character wide text mode. It     |
8070  REM |  assumes the screen is in that mode at entry.                      |
8080  REM ----------------------------------------------------------------------
8090  CLS
8100  GOSUB 500 ' Get Filename from User.
8110  IF ARCHNAME$="" THEN GOSUB 6100:RUN
8120  ON ERROR GOTO 8600:'Test for file available.
8125  OPEN ARCHDIR$ AS #1 LEN=32
8130  OPEN ARCHFIL$ AS #2 LEN=128
8135  GOSUB 720:' Go list directory for this file - and get highest sector in use in variable HILAST.
8137  PRINT:PRINT TOTDIR-NUMDIR;" files may be added to library ";ARCHNAME$
8138  IF TOTDIR-NUMDIR<1 THEN PRINT "No files can be added to this library.":GOSUB 6100:RUN
8140  PRINT:PRINT "Enter filenames to be added to library ";ARCHNAME$;". Enter null line to terminate."
8150  NUMFILES=0
8160  ON ERROR GOTO 8610
8170  NUMFILES=NUMFILES+1:PRINT "Filename #";NUMFILES;" <drv:filename.ext> :";:INPUT I$(NUMFILES)
8180  IF LEN(I$(NUMFILES))=0 THEN NUMFILES=NUMFILES-1:GOTO 8280
8190  FOR I=1 TO LEN(I$(NUMFILES))
8200  IF ASC(MID$(I$(NUMFILES),I))>96 THEN MID$(I$(NUMFILES),I)=CHR$(ASC(MID$(I$(NUMFILES),I))-32)
8210  NEXT I
8220  FOR J=1 TO NUMFILES-1
8230  IF I$(NUMFILES)=I$(J) THEN PRINT "ERROR - Same file specified twice.":NUMFILES=NUMFILES-1:GOTO 8170
8240  NEXT J
8250  OPEN I$(NUMFILES) FOR INPUT AS #3:CLOSE #3
8260  IF NUMFILES=TOTDIR-NUMDIR THEN GOTO 8280
8270  GOTO 8170
8280  ON ERROR GOTO 0
8290  IF NUMFILES<1 THEN PRINT "ERROR - No files specified.":GOTO 8140
8300  PRINT:PRINT NUMFILES;" files to be added to Library ";ARCHNAME$
8310  RECCNT=HILAST+LASTSEC:'Add new files to end of library.
8320  FOR I=1 TO NUMFILES
8330  INCNT=0
8340  OPEN I$(I) AS #3 LEN=128
8350  PRINT:PRINT "Copying file #";I;": ";I$(I);" (";LOF(3);"bytes ) --> Library: ";ARCHFIL$
8360  STARTCNT=RECCNT
8370  GOSUB 600 ' Go copy the file into the library.
8380  CLOSE #3
8390  CLOSE #2
8410  FIELD 1, 1 AS DONE$, 8 AS PRINAME$, 3 AS SECNAME$, 2 AS START$, 2 AS LAST$, 8 AS FILEDATE$, 8 AS FILETIME$
8420  LSET PRINAME$="":LSET SECNAME$=""
8430  LSET START$=MKI$(STARTCNT)
8440  LSET LAST$=MKI$(RECCNT-STARTCNT)
8450  LSET DONE$=CHR$(0)
8460  WKDATE$=DATE$:WKDATE$=LEFT$(WKDATE$,6)+RIGHT$(WKDATE$,2):LSET FILEDATE$=WKDATE$:LSET FILETIME$=TIME$
8470  IF INSTR(I$(I),":")=2 THEN PRI$=MID$(I$(I),3) ELSE PRI$=I$(I)
8480  IF INSTR(PRI$,".")<>0 THEN SEC$=MID$(PRI$,INSTR(PRI$,".")+1):PRI$=MID$(PRI$,1,INSTR(PRI$,".")-1)
8490  LSET PRINAME$=PRI$+SPACE$(8-LEN(PRI$))
8500  LSET SECNAME$=SEC$+SPACE$(3-LEN(SEC$))
8510  PUT #1,NUMDIR+I+1
8520  LSET DONE$=CHR$(255)
8530  PUT #1
8550  OPEN ARCHFIL$ AS #2 LEN=128
8560  NEXT I
8570  CLOSE
8580  PRINT:PRINT "LUADD completed - directory updated."
8590  GOSUB 6100:RUN
8600  IF ERR=53 THEN RESUME 1490 ELSE ON ERROR GOTO 0
8610  IF ERR=53 THEN PRINT:PRINT "File: ";I$(NUMFILES);" cannot be opened. Please re-specify.":NUMFILES=NUMFILES-1:RESUME 1690 ELSE ON ERROR GOTO 0